Const Ver As Integer = 11
Const Name As String = "YMSG"
Public Crypt(1) As String
Private Declare Function YMSG12_ScriptedMind_Encrypt Lib "YMSG12ENCRYPT.dll" (ByVal username As String, ByVal Password As String, ByVal Seed As String, ByVal result_6 As String, ByVal result_96 As String, intt As Long) As Boolean
Public Function getencrstrings(Name As String, Pass As String, Seed As String, Str1 As String, Str2 As String, mode As Long) As Boolean
Dim Ts As String, Ts2 As String, n As Long
On Error GoTo err
Ts = String(80, vbNullChar)
Ts2 = String(80, vbNullChar)
getencrstrings = YMSG12_ScriptedMind_Encrypt(Name, Pass, Seed, Ts, Ts2, mode)
n = InStr(1, Ts, vbNullChar)
Str1 = Left$(Ts, n - 1)
n = InStr(1, Ts2, vbNullChar)
Str2 = Left$(Ts2, n - 1)
Exit Function
err:
getencrstrings = False
End Function
Public Function Header(ByVal PacketType As String, ByVal pck As String) As String
Dim i As Integer
Dim X As Integer
X = 0
i = Len(pck)
Do While i > 255
i = i - 256
X = X + 1
Loop
Header = Name & Chr(0) & Chr(Ver) & String(2, 0) & Chr(X) & Chr(i) & Chr(0) & _
Chr("&H" & PacketType) & String(8, 0) & pck
Debug.Print Header
End Function
Public Function Login(YahooID As String) As String
Dim pck As String
pck = "6A€" & Crypt(0) & "A€96A€" & Crypt(1) & "A€0A€" & YahooID & "A€2A€" & YahooID & "A€192A€-1A€2A€1A€1A€" & YahooID & "A€99A€betaA€135A€6,0,0,1555A€148A€300A€59A€B04um3lh08ql2q&b=2A€59A€A€"
Login = Header("54", pck)
End Function
Public Function Get_Key(YahooID As String) As String
Dim pck As String
pck = "1A€" & YahooID & "A€"
Get_Key = Header("57", pck)
End Function

* This Is Your Login Button *

Private Sub Command_Click1()
Winsock1.Close
Winsock1.Connect "scs.msg.yahoo.com", 5050
End Sub

Private Sub Winsock1_Connect()
Status = "Connecting..."
Winsock1.SendData Get_Key(Text1) ' Text 1 Is The Y! Id =|
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Data As String, ChallengeString As String
Winsock1.GetData Data
Select Case Asc(Mid(Data, 12, 1))
Case Is = 87
ChallengeString = Split(Data, "94A€")(1)
ChallengeString = Split(ChallengeString, "A€")(0)
getencrstrings Text1, Text2, ChallengeString, Crypt(0), Crypt(1), 1
Winsock1.SendData Login(Text1.Text)
SessionKey = Mid(Data, 17, 4)
Case Is = 84
Status.Caption = "Invalid Password"
Winsock1.Close
Case Is = 85
Status.Caption = "Yahoo Id Connected "
End Select
Debug.Print Asc(Mid(Data, 12, 1)) & " - " & Data
End Sub


Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Winsock1.Close
Status = "Connection Error"
End Sub